home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 22 / AACD 22.iso / AACD / Programming / powerd / examples / Flare.d < prev    next >
Encoding:
Text File  |  2000-11-23  |  7.2 KB  |  315 lines
  1. // flare.d - simple lens flare renderer, it generates 24bit result in ram:flares.tga file
  2.  
  3. OPT    OPTIMIZE
  4.  
  5. MODULE    'intuition/intuition','intuition/screens','graphics/modeid','exec/memory',
  6.             'utility/tagitem'
  7.  
  8. CONST    W=320,H=240
  9.  
  10. PROC main()
  11.     DEF    flist:PTR TO flare,r,x,y
  12.     //
  13.     // flare definition
  14.     //
  15.     flist:=[
  16.         FL_Linear    , 50.0, 0.00,1.00,1.00,1.00,
  17.         FL_Power        , 60.0, 0.00,0.00,0.30,1.00,
  18.         FL_FadeRing    , 30.0,-0.10,0.20,0.00,0.00,
  19.         FL_Circle    , 10.0, 0.20,0.10,0.15,0.10,
  20.         FL_Ring        , 34.0, 0.25,0.15,0.10,0.10,
  21.         FL_Circle    , 20.0, 0.30,0.10,0.10,0.20,
  22.         FL_Circle    , 14.0, 0.40,0.10,0.10,0.10,
  23.         FL_Power        ,  2.0, 0.47,0.10,0.70,1.00,
  24.         FL_Circle    ,  4.0, 0.55,0.10,0.10,0.10,
  25.         FL_Circle    , 26.0, 0.60,0.10,0.10,0.20,
  26.         FL_Circle    , 12.0, 0.70,0.10,0.20,0.10,
  27.         FL_Linear    , 16.0, 0.85,0.00,0.10,0.40,
  28.         FL_FadeRing    ,100.0, 1.00,0.30,0.05,0.00,
  29.         FL_FadeRing    ,200.0, 1.50,0.05,0.20,0.10,
  30.         FL_Last]:flare
  31.     PrintF('Flare by MarK 23.2.2000\n')
  32.     PrintF('Press:\n\tLMB to change light position\n\tRMB to render flares\n\tany key for exit\n')
  33.     r,x,y:=Preview(flist)
  34.     IF r THEN Render(flist,x,y)
  35. ENDPROC
  36.  
  37. ENUM    FL_Last,
  38.         FL_Linear,
  39.         FL_Power,
  40.         FL_Circle,
  41.         FL_Ring,
  42.         FL_FadeRing
  43.  
  44. OBJECT flare
  45.     type:LONG,        // type of the flare (see FL... above)
  46.     size:FLOAT,        // size of the flare
  47.     pos:FLOAT,        // position on the flare line (0=light, 1.0=opposite the light)
  48.     r:FLOAT,            // colour of the flare
  49.     g:FLOAT,
  50.     b:FLOAT
  51.  
  52. //
  53. // preview and setup for rendering
  54. //
  55. PROC Preview(flist:PTR TO flare)(LONG,LONG,LONG)
  56.     DEF    s:PTR TO Screen,w:PTR TO Window,m:PTR TO IntuiMessage,end=FALSE,r=FALSE,mx,my
  57.     IF s:=OpenScreenTags(NIL,
  58.             SA_Width,W,
  59.             SA_Height,H,
  60.             SA_Depth,1,
  61.             SA_DisplayID,VGALORESDBL_KEY,
  62.             SA_Colors,[0,0,0,0,1,15,15,15,-1]:WORD,
  63.             TAG_END)
  64.         IF w:=OpenWindowTags(NIL,
  65.                 WA_Width,W,
  66.                 WA_Height,H,
  67.                 WA_CustomScreen,s,
  68.                 WA_IDCMP,IDCMP_MOUSEBUTTONS|IDCMP_VANILLAKEY,
  69.                 WA_Flags,WFLG_RMBTRAP|WFLG_ACTIVATE|WFLG_BORDERLESS,
  70.                 TAG_END)
  71.             SetAPen(w.RPort,1)
  72.             DrawFlare(w.RPort,flist,w.MouseX,w.MouseY)
  73.             mx:=w.MouseX
  74.             my:=w.MouseY
  75.             WHILE WaitPort(w.UserPort)
  76.                 IF m:=GetMsg(w.UserPort)
  77.                     IF m.Class=IDCMP_MOUSEBUTTONS
  78.                         IF m.Code=SELECTDOWN
  79.                             SetRast(w.RPort,0)
  80.                             DrawFlare(w.RPort,flist,mx:=w.MouseX,my:=w.MouseY)
  81.                         ELSEIF m.Code=MENUDOWN
  82.                             r:=TRUE
  83.                             end:=TRUE
  84.                         ENDIF
  85.                     ELSE
  86.                         end:=TRUE
  87.                     ENDIF
  88.                     ReplyMsg(m)
  89.                 ENDIF
  90.             EXITIF end=TRUE
  91.             ENDWHILE
  92.  
  93. //            WaitPort(w.UserPort)
  94.             CloseWindow(w)
  95.         ELSE PrintF('Unable to open window!\n')
  96.         CloseScreen(s)
  97.     ELSE PrintF('Unable to open screen!\n')
  98. ENDPROC r,mx,my
  99.  
  100. //
  101. // draw circles as flares
  102. //
  103. PROC DrawFlare(rp,flist:PTR TO flare,mx:FLOAT,my:FLOAT)
  104.     DEFF    cx,cy,dx,dy,x,y
  105.     cx:=W/2
  106.     cy:=H/2
  107.     dx:=cx-mx
  108.     dy:=cy-my
  109.     REPEAT
  110.         x:=dx*(flist.pos*2.0-1.0)
  111.         y:=dy*(flist.pos*2.0-1.0)
  112. //        PrintF('x=$\z\h[8]\ny=$\z\h[8]\n',x,y)
  113.         DrawEllipse(rp,x+cx,y+cy,flist.size/2,flist.size/2)
  114.         flist[]++
  115.     UNTIL flist.type=FL_Last
  116. ENDPROC
  117.  
  118. //
  119. // open output screen and window
  120. //
  121. PROC Render(flist:PTR TO flare,mx:FLOAT,my:FLOAT)
  122.     DEF    s:PTR TO Screen,w:PTR TO Window,vp,n,image:PTR TO RImage
  123.     IF s:=OpenScreenTags(NIL,
  124.             SA_Width,W,
  125.             SA_Height,H,
  126.             SA_Depth,8,
  127.             SA_DisplayID,VGALORESDBL_KEY,
  128.             TAG_END)
  129.         IF w:=OpenWindowTags(NIL,
  130.                 WA_Width,W,
  131.                 WA_Height,H,
  132.                 WA_CustomScreen,s,
  133.                 WA_IDCMP,IDCMP_MOUSEBUTTONS|IDCMP_VANILLAKEY,
  134.                 WA_Flags,WFLG_RMBTRAP|WFLG_ACTIVATE|WFLG_BORDERLESS,
  135.                 TAG_END)
  136.             vp:=ViewPortAddress(w)
  137.             FOR n:=0 TO 255 SetRGB32(vp,n,n<<24,n<<24,n<<24)
  138.             SetAPen(w.RPort,255)
  139.  
  140.             IF image:=NewImage(W,H)
  141. //                DrawFlare(w.RPort,flist,mx,my)
  142.                 RenderFlare(w.RPort,image,flist,mx,my)
  143.                 SaveTarga(image)
  144.                 DeleteImage(image)
  145.             ENDIF
  146.  
  147.             WaitPort(w.UserPort)
  148.             CloseWindow(w)
  149.         ELSE PrintF('Unable to open window!\n')
  150.         CloseScreen(s)
  151.     ELSE PrintF('Unable to open screen!\n')
  152. ENDPROC
  153.  
  154. //
  155. // render flare list
  156. //
  157. PROC RenderFlare(rp,im,flist:PTR TO flare,mx:FLOAT,my:FLOAT)
  158.     DEFF    cx,cy,dx,dy,x,y,xx,yy,i,sx,sy
  159.     cx:=W/2
  160.     cy:=H/2
  161.     dx:=cx-mx
  162.     dy:=cy-my
  163.     REPEAT
  164.         x:=dx*(flist.pos*2.0-1.0)
  165.         y:=dy*(flist.pos*2.0-1.0)
  166.         sx:=x-flist.size/2
  167. //        IF sx<-cx THEN sx:=-cx
  168.         FOR xx:=sx TO x+flist.size/2
  169.         NEXTIF xx<=-cx
  170.         EXITIF xx>=cx
  171.             sy:=y-flist.size/2
  172. //            IF sy<-cy THEN sy:=-cy
  173.             FOR yy:=sy TO y+flist.size/2
  174.             NEXTIF yy<=-cy
  175.             EXITIF yy>=cy
  176.                 i:=Flare(flist,xx,yy,x,y)
  177.                 SetAPen(rp,RRePlot(im,xx+cx,yy+cy,i*flist.r,i*flist.g,i*flist.b))
  178.                 WritePixel(rp,xx+cx,yy+cy)
  179.             ENDFOR
  180.             IF Mouse()=3 THEN RETURN
  181.         ENDFOR
  182.         flist[]++
  183.     UNTIL flist.type=FL_Last
  184. ENDPROC
  185.  
  186. //
  187. // get flare intensity
  188. //
  189. PROC Flare(flare:PTR TO flare,x:FLOAT,y:FLOAT,fx:FLOAT,fy:FLOAT)(FLOAT)
  190.     DEFF    i,l
  191.     x-=fx
  192.     y-=fy
  193.     l:=Sqrt(x*x+y*y)                    // l = distance of rendering pixel and flare center
  194.     l/=flare.size/2.0                    // unify
  195. //    l*=2
  196.     IF l>1.0 THEN RETURN 0.0        // no intersection, end
  197.     SELECT flare.type
  198.     CASE FL_Linear
  199.         i:=1.0-l
  200.     CASE FL_Power
  201.         i:=(1.0-l)*(1.0-l)
  202.     CASE FL_Circle
  203.         IF l>0.95
  204. //            i:=20.0*(1.0-l)
  205.             i:=(1.0-l)*20.0
  206.         ELSE
  207.             i:=1.0
  208.         ENDIF
  209.     CASE FL_Ring
  210.         IF l>0.90
  211.             i:=(1.0-l)*10.0
  212.         ELSEIF l>0.80
  213.             i:=(l-0.80)*10.0
  214.         ELSE
  215.             i:=0.0
  216.         ENDIF
  217.     CASE FL_FadeRing
  218.         IF l>0.95
  219.             i:=(1.0-l)*20.0
  220.         ELSEIF l>0.50
  221.             i:=(l-0.50)*2.0
  222.         ELSE
  223.             i:=0.0
  224.         ENDIF
  225.     DEFAULT
  226.         i:=0.0
  227.     ENDSELECT
  228.     IF i>1.0 THEN i:=1.0
  229.     IF i<0.0 THEN i:=0.0
  230. ENDPROC i
  231.  
  232. //
  233. // image definition
  234. //
  235. OBJECT RGB
  236.     r:UBYTE,
  237.     g:UBYTE,
  238.     b:UBYTE
  239.  
  240. OBJECT BGR                    // for targa saving
  241.     b:UBYTE,
  242.     g:UBYTE,
  243.     r:UBYTE
  244.  
  245. OBJECT RImage
  246.     Width:LONG,
  247.     Height:LONG,
  248.     Pixel:PTR TO RGB
  249.  
  250. PROC NewImage(w,h)(PTR TO RImage)
  251.     DEF    image:PTR TO RImage
  252.     IF (image:=AllocMem(SIZEOF_RImage,MEMF_PUBLIC|MEMF_CLEAR))=NIL THEN RETURN NIL
  253.     image.Width:=w
  254.     image.Height:=h
  255.     IF (image.Pixel:=AllocMem(SIZEOF_RGB*w*h,MEMF_PUBLIC|MEMF_CLEAR))=NIL
  256.         FreeMem(image,SIZEOF_RImage)
  257.         RETURN NIL
  258.     ENDIF
  259. ENDPROC image
  260.  
  261. PROC RRePlot(image:PTR TO RImage,x,y,r:FLOAT,g:FLOAT,b:FLOAT)(LONG=0)
  262.     DEF    c,pixel:PTR TO RGB
  263.     IF x>=image.Width OR y>=image.Height OR x<0 OR y<0 THEN RETURN
  264.     r*=255
  265.     g*=255
  266.     b*=255
  267.     pixel:=image.Pixel[y*image.Width+x]
  268.  
  269.     r+=pixel.r
  270.     g+=pixel.g
  271.     b+=pixel.b
  272.  
  273.     IF r>255 THEN r:=255
  274.     IF g>255 THEN g:=255
  275.     IF b>255 THEN b:=255
  276.  
  277.     pixel.r:=r
  278.     pixel.g:=g
  279.     pixel.b:=b
  280.     c:=(pixel.r+pixel.g+pixel.b)/3
  281. ENDPROC c
  282.  
  283. PROC DeleteImage(image:PTR TO RImage)
  284.     IF image.Pixel THEN FreeMem(image.Pixel,image.Width*image.Height*SIZEOF_RGB)
  285.     FreeMem(image,SIZEOF_RImage)
  286. ENDPROC
  287.  
  288. //
  289. // save 24bit targa image
  290. //
  291. PROC SaveTarga(image:PTR TO RImage)
  292.     DEF    buff:PTR TO BGR,f,x,y,length,comment:PTR TO CHAR
  293.     PrintF('Saving...\b')
  294.     IF buff:=AllocMem(image.Width*image.Height*SIZEOF_BGR,MEMF_PUBLIC)
  295.         FOR y:=0 TO image.Height-1
  296.             FOR x:=0 TO image.Width-1
  297.                 buff[y*image.Width+x].r:=image.Pixel[y*image.Width+x].r
  298.                 buff[y*image.Width+x].g:=image.Pixel[y*image.Width+x].g
  299.                 buff[y*image.Width+x].b:=image.Pixel[y*image.Width+x].b
  300.             ENDFOR
  301.         ENDFOR
  302.         IF f:=Open('ram:flares.tga',NEWFILE)
  303.             comment:='$VER:This picture is generated by Martin Kuchinka''s simple Flare renderer.'
  304.             length:=StrLen(comment)
  305.             Write(f,[length,0,2,0,0,0,0,24,0,0,0,0,image.Width,image.Width>>8,image.Height,image.Height>>8,24,$20]:UBYTE,18)
  306.             Write(f,comment,length)
  307.             Write(f,buff,image.Width*image.Height*SIZEOF_BGR)
  308. //            Write(f,image.Pixel,image.Width*image.Height*SIZEOF_BGR)
  309.             PrintF('Done.     \n')
  310.             Close(f)
  311.         ELSE PrintF('Unable to write image!\n')
  312.         FreeMem(buff,image.Width*image.Height*SIZEOF_BGR)
  313.     ELSE PrintF('Not enough memory!\n')
  314. ENDPROC
  315.